COMMENT ⊗   VALID 00022 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	Definitions.
C00007 00003	Flag definitions, channel definitions, and LOOKUP/ENTER blocks.
C00010 00004	Storage arrays, dump mode commands, misc. storage.
C00014 00005	Start of main program (DOER).  Prepare to read in uncataloged story from 'NEWS' file.
C00019 00006	Read in undun story.
C00022 00007	Check seq nbr of story.
C00024 00008	For each word in story, collect its letters.
C00027 00009	Check current word for indicator of a correction, an add, or a take.
C00030 00010	Link up current story to earlier one.  See if we have a take.
C00033 00011	Find appropriate place in sorted list for current word.
C00037 00012	Open INDEX and DICT files.  Read in WORDS and LINKS files.
C00040 00013	Look for keywords in story.  Link up any that are found.
C00043 00014	Link up keyword in story.
C00046 00015	Categorize story by longest keyword that matched.  Write out new data.
C00050 00016	Write out new versions of files.
C00055 00017	PAUSE1-4	DIGEST	DONTDO	GONE
C00060 00018	UUCODE
C00065 00019	INTRPT	CHGNAM
C00067 00020	GETUFD	GUFD	DELALL	INDEL	AUTONT
C00080 00021	PROCRQ
C00094 00022	XIT	
C00096 ENDMK
C⊗;
;Definitions.
	TITLE	DOER
EXTERNAL JOBAPR,JOBCNI,JOBREL,JOBFF,JOBSA
;     ACCUMULATOR ASSIGNMENTS
F←←0			;contains flags in LH and "@" (octal 100) in RH
A←1			;temporary AC
B←2			;temporary AC
C←3			;temporary AC
AVAIL←←3		;pointer to an available link block in LINKS
WD←4			;the word being looked at in the sorted list
PREV←←4
D←4			;AC for the number of a detected error
DICTWD←5		;pointer to the current dictionary entry
FIRST←6			;ptr to text of current dictionary word
AC1←←7			;temporary AC
AC2←←10			;temporary AC
SORPTR←7		;pointer to current entry in the sorted list (SORDID)
TXTPTR←10		;byte pointer for depositing letters into TEXT area
PART1←←11		;four ac's for holding the (possible) 4 words per
PART2←←12		;	entry in the sorted list. Used in comparison.
PART3←←13
PART4←←14
PT1	← 11
PT2	← 12
PT3	← 13
PT4	← 14
PT5	← 15
CHAR←←11		;current character of story
DISPL←←12
SIZE←←13
BPTR←←15		;byte pointer into buffer holding current story
LWD←16			;the last word looked at in the sorted list
P←17

LF←←12  CR←←15

NKEYS←←=20		;max nbr of keywords all starting with same word
PDLEN←←=30		;length of push down list

SPECS←←4		;number of special words at front of INDEX file
XSIZE←←3		;size of the index entry for one story
MAXNBR←←=500		;maximum number of stories allowed
XLEN←MAXNBR*XSIZE+SPECS	;total size of space for index entries
LLEN←←10000		;size of LINKS file
WLEN←←6400		;size of WORDS file
DLEN←←10000		;size of DICT array
;Flag definitions, channel definitions, and LOOKUP/ENTER blocks.
DEFINE UNDUN {INDEX}	;first word in INDEX file
DEFINE NEW {INDEX+1}	;second word
DEFINE OLD {INDEX+2}	;third word
	LOC	41
	JSR	UUCODE
	LOC
OPDEF	UEXIT	[001000,,];minor error. swap in new version of DOER
OPDEF	UERROR	[002000,,];moderate error. write message in ERRORS file and swap
OPDEF	UBIGERR	[003000,,];horrendous error. write message in ERRORS file

;LEFT HALF FLAGS (AC 0)
LESS  ← 400000	; used when looking for an earlier story with given seq nbr
MISSIN← 100000	; 1 if story sought in NEWS was not found
TAKEFG←← 40000	; 1 if current story is a TAKE
CATFLG←← 20000	; 1 if current word has been used to categorize the story

comment ⊗ Channel assignments:
 0: NEWS	input
 1: INDEX	input
 2: DOTIM	input/output
 3: DICT	input
 4: WORDS	input
 5: LINKS	input
 6: INDEX	input
 7: INDEX	output
10: LINKS	output
11: DICT	output
end of comment ⊗
NT←←12		;CHANNEL FOR CREATING NEW NOTIF FILE
TAD←←13		;FOR READING OLD NOTIF AND .ADD AND .TAD FILES
TDL←←14		;FOR READING .DEL AND .TDL FILES; FOR DELETING .TDL AND .TAD FILES
DUN←←15		;FOR READING/WRITING SPECIAL FLAG FILE
NAP←←16		;FOR WRITING .NAP FILES
UFD←←17		;FOR READING THE UFD

NEWSF:	SIXBIT	/NEWS/	;block for LOOKUP and ENTER for NEWS file
	BLOCK	3
INDEXF:	SIXBIT	/INDEX/	;block for LOOKUP and ENTER for INDEX file
	BLOCK	3
LINKSF: SIXBIT	/LINKS/	;block for LOOKUP and ENTER for LINKS file
	BLOCK	3
DICTF:	SIXBIT	/DICT/	;block for LOOKUP and ENTER for DICT file
	BLOCK	3
WORDSF:	SIXBIT	/WORDS/	;block for LOOKUP for WORDS file
	BLOCK	3
ERRORF:	SIXBIT	/ERRORS/;block for LOOKUP and ENTER for ERRORS file
	BLOCK	3
DOTIMF:	SIXBIT	/DOTIM/	;LOOKUP/ENTER block for statistics file
	BLOCK	3
DIGSTF:	SIXBIT	/DIGEST/;ENTER block for saving digest on 2,2
	BLOCK	3
;Storage arrays, dump mode commands, misc. storage.

BUF:			;buffer to hold part of ERRORS file is same as STORY buffer
STORY:	BLOCK	2200	;buffer to hold stories
INDEX:	BLOCK	XLEN	;core array for holding index pointers for stories
LINKS:	BLOCK	LLEN	;holds the assorted relationships for words found in DICT
DICT:	BLOCK	DLEN	;array for DICT file
WORDS:	BLOCK	WLEN	;holds the words actually pointed to in DICT
SORDID:	BLOCK	=600	;holds the sorted list of words in a story
TEXT:	BLOCK	=1500	;holds the characters of the words in the story
PDLIST:	BLOCK	PDLEN	;push down list
KEYS:	BLOCK	NKEYS	;ptrs to dictionary entries for keywords categorizing story

CMD:	IOWD	1,STORY		;command for reading in a story to be cataloged
	0
XCMD:	IOWD	XLEN,INDEX	;command for reading/writing INDEX
	0
LCMD:	IOWD	LLEN,LINKS	;command for reading/writing LINKS
	0
DCMD:	IOWD	200,DICT	;command for reading/writing DICT
	0
WCMD:	IOWD	WLEN,WORDS	;command for reading WORDS
	0
DTCMD:	XWD	-(DATLEN+2),TOTDAT-1	;command for reading/writing statistics
	0
OCMD:	BLOCK	2		;command for writing out digest on 2,2
DSK17:	217			;block for OPENing the DSK in mode 17 many times
	SIXBIT	/DSK/		;200 bit means take error return automatically
	0			;	if DISK IS FULL or BAD RETRIEVAL
SWAPBK:	SIXBIT	/DSK/
	SIXBIT	/DOER/
	SIXBIT	/DMP/
	1			;start at 1 past normal starting address
	SIXBIT	/ APSYS/
NAME:	SIXBIT	/[DOER]/	;name DOER uses while running
WRDCNT:	0
LKOVFL:	0			;LINKS space overflow flag
LOSEQ:	0			;lowest acceptable seq nbr for earlier take
HISEQ:	0			;highest acceptable seq nbr for earlier take
SPBPTR:	0			;special byte ptr
NRDOER:	0			;code indicating number of other DOERs
TTYLIN:	0			;word for indicating whether DOER is detached
STCNT:	0		;word for number of stories we have yet to look for earlier take
LEN:	0			;pseudo length of a story word
CHCNT:	0			;character count for the UNDUN story
CATNBR:	0			;nbr of similar keywords categorizing story
THSSTY:	0			;INDEX NUMBER OF CURRENT STORY (USED BY AUTONT)
BEGSTY:	POINT 36,STORY,35	;BYTE POINTER TO BEGINNING OF STORY (USED BY AUTONT)
DODAT:	DOTIM:	0		;FIRST DATA WORD: TOTAL LOCAL TIME USED BY DOER
	ANTIM:	0		;SECOND DATA WORD: TIME USED IN NOTIFICATION
DATLEN←←.-DODAT
TOTDAT:	BLOCK	DATLEN+2	;GLOBAL DATA FOR DOER
;Start of main program (DOER).  Prepare to read in uncataloged story from 'NEWS' file.

DOER:	SKIPA			;normal starting address leaves RESTART = 0
	SETOM	RESTAR#		;if swapped in by self, set RESTAR = -1
	RESET
	MOVEI	F,"@"		;clear all flags in LH, and load "@" in RH
	MOVEI	A,INTRPT	;get address of interrupt level module
	MOVEM	A,JOBAPR	;store it in JOBAPR
	MOVE	A,[400200000]	;enable for interrupts on parity errors and
	INTENB	A,		;	pdl ov
	MOVEI	A,200000
	INTGEN	A,		;generate a pdl ov interrupt to set the job name
	MOVE	A,NRDOER	;get code nbr indicating number of other DOERs
	JRST	.+2(A)
	UBIGERR	4	;	;ONE OTHER DOER ALREADY EXISTS!
	UBIGERR	10	;	;TWO OR MORE DOERS ALREADY EXIST!
	SETZB	A,ANTIM		;INITIALIZE RUNTIM USED BY DOER
	RUNTIM	A,
	MOVNM	A,DOTIM
	
AGAIN3:	OPEN	1,DSK17		;get the index file
	UERROR	14	;	;OPEN FAILED ON DSK
	SETZM	INDEXF+3
	LOOKUP	1,INDEXF	;INDEX file
	JRST	PAUSE3
	IN	1,XCMD		;read in INDEX file
	JRST	.+2
	UERROR	20	;	;IN UUO FAILED TO READ IN INDEX FILE
	RELEAS	1,		;INDEX file
	MOVE	P,[INITPD: IOWD PDLEN,PDLIST];init the stack ptr
MORE:	MOVE	B,UNDUN		;grab UNDUN from the INDEX file
	CAMN	B,NEW		;has UNDUN caught up with NEW?
	JRST	XIT		;yes.  FINISH UP BY WRITING OUT STATISTICS
	INSKIP
	JRST	DOMORE
	OUTSTR	[ASCIZ/Manual stop.  CONTINUE will work./]
	CLRBFI
	EXIT	1,
;check if UNDUN points to a story that has been deleted or otherwise wiped out
DOMORE:	MOVE	A,OLD		;get index of OLD story and compare with
	CAMG	A,NEW		;	index of NEW area
	JRST	OLDLES		;OLD index is above (less than) NEW index
	CAML	B,NEW		;NEW index is above (less than) OLD index.
	CAML	B,OLD		;is UNDUN between OLD and NEW?
	JRST	DOMOR1		;no.  everything is ok.
OLDUN:	MOVEM	A,UNDUN		;make the oldest story the first undun one
	MOVE	B,A
	JRST	DOMOR1
OLDLES:	CAML	B,OLD		;OLD index is above (less than) NEW index
	CAML	B,NEW		;is UNDUN between OLD and NEW?
	JRST	OLDUN		;no! UNDUN story seems to have been deleted (or something)
;Read in undun story.

DOMOR1:	MOVE	SIZE,B		;calculate size of story
	ADDI	SIZE,XSIZE
	CAIL	SIZE,XLEN
	MOVEI	SIZE,SPECS
	MOVN	SIZE,INDEX+1(SIZE)
	ADD	SIZE,INDEX+1(B)
	JUMPL	SIZE,ONWARD
DOWN:	MOVN	SIZE,INDEX+3	;UNDUN story is last in NEWS. get ptr to end of NEWS
	ADD	SIZE,INDEX+1(B)
ONWARD:	ASH	SIZE,-13	;right adjust the negated size of the UNDUN story
;	OUTSTR	[ASCIZ / STORY! /]
	HRRZ	DISPL,INDEX+1(B);get displacement of UNDUN story
	ASH	DISPL,-13	;right-adjust displacement
	MOVN	A,DISPL		;make displacement negative (size is already negative)
	ADD	A,SIZE		;calculate length of NEWS stuff to be read in
	HRLM	A,CMD		;put length in the command word
	SETZM	LINKS+1		;clear the back ptr to slots for this story
	TLZ	F,TAKEFG+MISSIN	;clear these two flags

AGAIN1:	OPEN	0,DSK17		;prepare to read the NEWS file
	UERROR	24	;	;OPEN FAILED ON DSK
	MOVE	A,[' APSYS']	;ALWAYS READ NEWS FILE FROM [AP,SYS]
	MOVEM	A,NEWSF+3
	LOOKUP	0,NEWSF		;NEWS file
	JRST	PAUSE1		;can't read NEWS.  FILER is writing it
	HLRZ	A,INDEX+1(B)	;get record number for UNDUN story
	USETI	0,(A)
	IN	0,CMD		;input the UNDUN story into STORY
	JRST	.+2
	UERROR	30	;	;IN UUO FAILED TO READ IN NEWS STORY
	RELEAS	0,		;NEWS file
	MOVEI	BPTR,STORY-1(DISPL)	;point byte pointer at first word of story
	HRLZM	SIZE,OCMD	;SET UP OUTPUT COMMAND IN CASE WE HAVE A DIGEST
	HRRM	BPTR,OCMD	; "   "   "       "
	HRRM	BPTR,BEGSTY	;SAVE POINTER TO BEGINNING OF STORY (FOR AUTONT)
	HRLI	BPTR,700	;initialize byte pointer
	MOVE	TXTPTR,[POINT 7,TEXT-1,34]  ;initialize byte ptr to start of TEXT
	MOVE	A,SIZE		;put number of chars in story into CNT by
	ASH	A,2		;	multiplying size by 5
	ADD	A,SIZE
	MOVEM	A,CHCNT		;store number of chars
	MOVEI	SORPTR,1	;initialize SORPTR to start of SORDID
;Check seq nbr of story.

	MOVEI	B,3		;prepare to look for 3 digits of sequence nbr
	SETZ	C,
NEXTDG:	ILDB	A,BPTR		;get a char from first word of story
	CAIG	A,"9"		;is it a digit?
	CAIGE	A,"0"
	JRST	GONE		;no!
	OUTCHR	A	;TYPE OUT THE SEQUENCE NUMBER OF THIS STORY
	IMULI	C,=10		;yes.  multiply sum of previous digits by =10
	ADDI	C,-60(A)	;add in current digit
	SOJG	B,NEXTDG	;got all 3 digits of seq nbr?
	MOVEI	B,3		;prepare to look for 3 spaces after the seq nbr
	ILDB	A,BPTR		;yes. get char after the 3 digits
	CAIE	A," "		;do two spaces follow the digits?
	JRST	GONE		;no!
	SOJG	B,.-3
	OUTCHR	A	;PRINT SPACE BETWEEN SEQUENCE NUMBERS
	ADDI	BPTR,3		;skip over time/date at front of story
	MOVE	B,UNDUN
	HRRZ	A,INDEX+2(B)	;GET SUPPOSED SEQ NBR OF STORY
	CAME	C,A		;DOES STORY IN NEWS HAVE CORRECT SEQ NBR?
	JRST	GONE		;NO!
	MOVEM	C,HISEQ		;SAVE SEQ NBR OF CURRENT STORY
	JUMPE	C,DONTDO	;dont categorize stories 000 and 001
	CAIN	C,1
	JRST	DONTDO
	CAIE	C,=200		;dont categorize stories 200 and 201
	CAIN	C,=201
	JRST	DONTDO
	CAIE	C,2		;is this the PMS digest (story 002)?
	CAIN	C,=202		;is this the AMS digest (story 202)?
	JRST	DIGEST		;yes to one of these
;For each word in story, collect its letters.

	MOVEI	A,=100		;number of words at the front of the story that
	MOVEM	A,WRDCNT	;	are checked for special meanings
	SETZM	SORDID		;zero the header for the sorted list
BETW:	AOSLE	CHCNT		;begin reading characters until a letter is hit or
	JRST	READ		;	there are no more characters
	ILDB	CHAR,BPTR	;get next character from story
	CAIL	CHAR,"A"
	JRST	LTR
	CAIL	CHAR,"0"	;character is not a letter
	CAILE	CHAR,"9"	;is it a digit?
	JRST	BETW		;no
	JRST	CONT		;yes
LTR2:	TRZ	CHAR,40		;make all letters upper case
	JRST	MIDDL
LTR:	TRZ	CHAR,40		;make all letters upper case
CONT:	MOVEM	TXTPTR,SORDID(SORPTR);store byte ptr to TEXT of this new word
MIDDL:	IDPB	CHAR,TXTPTR	;deposit this letter in TEXT
	AOSLE	CHCNT		;any more chars in story?
	JRST	DEP100		;no
	ILDB	CHAR,BPTR	;yes, get one
	CAIL	CHAR,"A"
	JRST	LTR2		;it's a letter
	CAIGE	CHAR,"0"	;it's not a letter
	JRST	DEP100		;nor a digit
	CAIG	CHAR,"9"
	JRST	MIDDL		;it is a digit and the word goes on
DEP100:	IDPB	F,TXTPTR	;end of word.  fill out text word with @'s
	TLNE	TXTPTR,760000
	JRST	DEP100
	HRRZ	A,SORDID(SORPTR);get ptr to beginning of current word
	MOVE	PART1,1(A)	;move word to PARTS for comparison for sorting
	MOVE	PART2,2(A)
	MOVE	PART3,3(A)
	MOVE	PART4,4(A)
;Check current word for indicator of a correction, an add, or a take.

	SOSGE	WRDCNT			;is current word among first words of story?
	JRST	ON			;no
	CAMN	PART1,[ASCII /TAKES/]	;is story the first of several takes?
	JRST	[TLO  F,TAKEFG		;yes.  mark it so
		 JRST ON]
	CAMN	PART1,[ASCII /TAKE@/]	;is story possibly a take of an earlier story?
	JRST	TAKE			;yes
	TDNE	PART1,[372010040000]	;is current word possibly a seq nbr?
	JRST	ON			;no
	SETCA	PART1,			;yes
	TDNE	PART1,[405406030000]	;check appropriate bits for 1's
	JRST	[SETCA	PART1,		;not a seq nbr.  re-complement PART1 back
		 JRST	ON]		;	to normal and go on
	SETCA	PART1,
;is a seq nbr.
	LDB	B,[POINT 7,PART1,13]	;AC B WILL HOLD THE REFERENCED SEQ NBR IN BINARY
	SUBI	B,60			;CONVERT 1ST DIGIT TO BINARY FROM ASCII
	IMULI	B,=10
	LDB	C,[POINT 7,PART1,20]
	ADDI	B,-60(C)		;ADD IN 2ND DIGIT OF SEQ NBR
	IMULI	B,=10
	LDB	C,[POINT 7,PART1,27]
	ADDI	B,-60(C)		;ADD IN 3RD DIGIT OF SEQ NBR

	MOVE	PREV,UNDUN		;prepare to look up index entry for prev story
	TLZ	F,LESS
	CAMGE	B,HISEQ			;does earlier story have smaller seq nbr?
TURNON:	TLO	F,LESS			;yes
NXPREV:	CAMN	PREV,OLD		;have we gotten back to oldest story?
	JRST	ON			;yes.  give up search
	SUBI	PREV,XSIZE		;no.  get index of the previous story
	CAIGE	PREV,SPECS
	MOVEI	PREV,XLEN-XSIZE
	HRRZ	C,INDEX+2(PREV)		;GET SEQ NBR OF THIS PREVIOUS STORY
	CAMN	B,C			;IS THE PREV STORY THE ONE REFERRED TO?
	JRST	LINKEM			;yes!
	CAIGE	B,=500			;is current story a special story?
	CAIL	C,=500			;is prev story a special story?
	JRST	NXPREV			;one of them is. dont make termination test
	CAMG	B,C			;have we passed seq nbr of desired story?
	JRST	TURNON			;no.  we are headed for it now
	TLNN	F,LESS			;yes.  were we ever headed for it?
	JRST	NXPREV			;no.  keep searching
	JRST	ON			;yes.  give up the search
;Link up current story to earlier one.  See if we have a take.

LINKEM:	OPEN	7,DSK17			;grab INDEX file
	UERROR	34	;	;OPEN FAILED ON DSK
	SETZM	INDEXF+1
	SETZM	INDEXF+2
	SETZM	INDEXF+3
	ENTER	7,INDEXF
	JRST	[RELEAS 7,
		 MOVEI	A,1
		 SLEEP	A,
		 JRST	LINKEM]
	JRST	FINISH

TAKE:	MOVEM	BPTR,SPBPTR		;copy the (byte) ptr into the story
TAK1:	ILDB	CHAR,SPBPTR		;get next char from story
	CAIE	CHAR,"T"		;is it a "T" (for "Two")?
	CAIN	CHAR,"t"		;   or a "t" (as in "two")?
	JRST	TAK9			;YES.  we have a follow up take (I hope)
	CAIL	CHAR,"A"		;no.  is it a letter?
	JRST	ON
	CAIL	CHAR,"0"		;no.
	CAILE	CHAR,"9"		;is it a digit?
	JRST	TAK1			;no.  get next char
TAK9:	MOVE	PREV,UNDUN		;yes.  we have, eg: take 2
	TLO	F,TAKEFG		;set take flag in case cant find original take
	HRREI	A,-6			;number of stories back we are willing
	MOVEM	A,STCNT			;	to look for the earlier take
	ADD	A,HISEQ
	MOVEM	A,LOSEQ			;SAVE MIN SEQ NBR WE CAN ACCEPT FOR EARLIER TAKE
TAK8:	SUBI	PREV,XSIZE		;get index of the previous story
	CAIGE	PREV,SPECS		;	so that we can link current
	MOVEI	PREV,XLEN-XSIZE		;	story with the previous one,
	HRRZ	A,INDEX+2(PREV)		;	which should be an earlier
	CAML	A,LOSEQ			;	take of the same story.
	CAMLE	A,HISEQ			;IS SEQ NBR OF THIS PREV STORY IN RIGHT RANGE?
	JRST	GETNXT			;NO.  GET NEXT PREV STORY.
	HRRE	C,INDEX(PREV)		;YES.  IS THIS PREV STORY A TAKE?
	AOJE	C,LINKEM		;IF SO, LINK UP TO THE CURRENT STORY
GETNXT:	AOSGE	STCNT			;HAVE WE EXAMINED LIMIT OF PREV STORIES?
	JRST	TAK8			;NO.  TRY THE NEXT PREV STORY.
;Find appropriate place in sorted list for current word.

ON:	MOVE	A,SORDID(SORPTR);retrieve byte ptr into TEXT for current word
	SUB	A,TXTPTR	;get length of word
	HRLM	A,SORDID(SORPTR);save length of this word
	CAMGE	A,[-4]		;is word longer than 20 letters?
	HRREI	A,-4		;yes.  ignore all but first 20 letters
	MOVEM	A,LEN		;save pseudo length of this word (max = 4)
	SETZ	LWD,		;LWD points to the last examined word in the list
NEXT:	HLRZ	WD,SORDID(LWD)	;get pointer from LWD to next WD
	TRZ	WD,700000	;zero out length bits that were in the pointer
	JUMPE	WD,INSERT	;if null pointer, insert word at end of list
	HRRZ	FIRST,SORDID(WD);get pointer from WD to text (characters) of word
	MOVE	A,LEN		;load A with length of current word (in words)
	CAME	PART1,1(FIRST)	;method of comparison: compare first parts.
	JRST	CHECK1		;	If unequal, jump out. Otherwise, if
	AOJGE	A,INSERT	; 	there is still part of the word left,
	CAME	PART2,2(FIRST)	;	continue comparing.If the word is the
	JRST	CHECK2		;	same as an existing word, go to INSERT to
	AOJGE	A,INSERT	;	insert it again.
	CAME	PART3,3(FIRST)
	JRST	CHECK3
	AOJGE	A,INSERT
CHECK4:	CAMG	PART4,4(FIRST)	;note that we only need one CAM for the last part (PART4)
	JRST	INSERT
	JRST	ADVNCE
CHECK3:	CAMG	PART3,3(FIRST)	;if it is greater, then you want to continue checking.
	JRST	INSERT		;if it is less, you want to insert it where you are
	JRST	ADVNCE		;advance the pointers.
CHECK2:	CAMG	PART2,2(FIRST)
	JRST	INSERT
	JRST	ADVNCE
CHECK1:	CAMG	PART1,1(FIRST)
	JRST	INSERT
ADVNCE:	MOVE	LWD,WD		;the new LWD is the old WD
	JRST	NEXT		;continue down list looking for place to insert current word

;insert next word into list of previously sorted words.

INSERT:	HLRZ	A,SORDID(SORPTR);retrieve the size of current word
	ASH	A,17		;move the size to the left hand bits of AC right
	ADD	A,WD		;put the link in the low order bits of AC right
	HRLM	A,SORDID(SORPTR);store the length and link of the new word
	HLRZ	A,SORDID(LWD)	;get the length and link of LWD
	TRZ	A,77777		;zero the link
	ADD	A,SORPTR	;add in the new link
	HRLM	A,SORDID(LWD)	;store the length and new link of LWD
	ADDI	SORPTR,1	;increment SORPTR to next word not yet sorted
	JRST	BETW
;Open INDEX and DICT files.  Read in WORDS and LINKS files.

READ:	OPEN	7,DSK17		;prepare to open INDEX for writing new version
	UERROR	40	;	;OPEN FAILED ON DSK
	SETZM	INDEXF+1
	SETZM	INDEXF+2
	SETZM	INDEXF+3
	ENTER	7,INDEXF	;INDEX file
	JRST	PAUSE2		;FILER must be writing INDEX now.  wait a bit

AGAIN4:	OPEN	11,DSK17	;create new DICT
	UERROR	42	;	;OPEN FAILED ON DSK
	SETZM	DICTF+1
	SETZM	DICTF+2
	SETZM	DICTF+3
	ENTER	11,DICTF
	JRST	PAUSE4
	OPEN	3,DSK17		;read in old DICT
	UERROR	43	;	;OPEN FAILED ON DSK
	SETZM	DICTF+3
	LOOKUP	3,DICTF
	UERROR	44	;	;LOOKUP FAILED ON DICT
	MOVS	A,DICTF+3	;GET WORD COUNT FROM LOOKUP BLOCK
	JUMPE	A,.+2		;ZERO WORD COUNT IS BAD FOR DICT
	CAMGE	A,[-DLEN]
	UBIGERR	45	;	;DICT IS TOO SMALL, OR TOO BIG TO FIT IN CORE ARRAY
	HRLM	A,DCMD		;PUT LENGTH OF FILE INTO DUMP MODE COMMAND
	IN	3,DCMD		;READ IN DICT
	JRST	.+2
	UERROR	46		;IN UUO FAILED TO READ IN DICT
	RELEAS	3,

	OPEN	4,DSK17		;read in WORDS
	UERROR	50	;	;OPEN FAILED ON DSK
	SETZM	WORDSF+3
	LOOKUP	4,WORDSF
	UERROR	54	;	;LOOKUP FAILED ON FILE: WORDS
	IN	4,WCMD
	JRST	.+2
	UERROR	60	;	;IN UUO FAILED TO READ IN FILE: WORDS
	RELEAS	4,

	OPEN	5,DSK17		;read in LINKS
	UERROR	64	;	;OPEN FAILED ON DSK
	SETZM	LINKSF+3
	LOOKUP	5,LINKSF
	UERROR	70	;	;LOOKUP FAILED ON FILE: LINKS
	IN	5,LCMD
	JRST	.+2
	UERROR	74	;	;IN UUO FAILED TO READ IN FILE: LINKS
	RELEAS	5,
;Look for keywords in story.  Link up any that are found.

	SETZB	WD,LINKS+1	;pt to first word and init back ptr from new story.
	MOVEI	DICTWD,2		;point to first entry in DICT
	SETOM	CATNBR			;indicate no similar keywords categorized
NEXTWD:	TLZ	F,CATFLG		;clear the "categorized" flag
	HLRZ	WD,SORDID(WD)		;get link to next word in list
	ANDI	WD,77777		;zero out the length field
	JUMPE	WD,DONE			;a zero link means end of list
	HRRZ	TXTPTR,SORDID(WD)	;get the pointer to the text of this word
	MOVE	PART1,1(TXTPTR)		;load the text into ACs (max of 20 chars)
	MOVE	PART2,2(TXTPTR)
	MOVE	PART3,3(TXTPTR)
	MOVE	PART4,4(TXTPTR)
	HLRO	A,SORDID(WD)		;get negative of length of this word
	ASH	A,-17			;right adjust the length
	SUB	TXTPTR,A		;advance TXTPTR to next word in story
	CAMGE	A,[-4]
	HRROI	A,-4			;make pseudo length of word be 4
	MOVEM	A,LEN			;save pseudo length of this word
	JRST	SAMDWD			;DONT GET NEW DICT WORD. USE SAME ONE AGAIN.

NXTDWD:	ADDI	DICTWD,2		;move ptr to next entry in dictionary
	SETOM	CATNBR			;INDICATE NO SIMILAR KEYWORDS CATEGORIZED
SAMDWD:	HLRZ	FIRST,DICT(DICTWD)	;get pointer to text of dictionary word
	MOVE	A,LEN			;put length of current word into A
	CAME	PART1,WORDS(FIRST)	;compare parts until inequality or
	JRST	CK1			;	until no more parts left in
	AOJGE	A,EQUAL			;	which case words must be equal
	CAME	PART2,WORDS+1(FIRST)
	JRST	CK2
	AOJGE	A,EQUAL
	CAME	PART3,WORDS+2(FIRST)
	JRST	CK3
	AOJGE	A,EQUAL
	CAMN	PART4,WORDS+3(FIRST)
	JRST	EQUAL

CK4:	CAMG	PART4,WORDS+3(FIRST)	;words unequal: see which word comes first
	JRST	NEXTWD			;Word not in dictionary (story word first)
	JRST	NXTDWD			;Get next dictionary word (dict word first)
CK3:	CAMG	PART3,WORDS+2(FIRST)
	JRST	NEXTWD
	JRST	NXTDWD
CK2:	CAMG	PART2,WORDS+1(FIRST)
	JRST	NEXTWD
	JRST	NXTDWD
CK1:	CAMG	PART1,WORDS(FIRST)
	JRST	NEXTWD
	JRST	NXTDWD
;Link up keyword in story.

EQUAL:	HLRZ	A,DICT+1(DICTWD)	;is current dict word part of a mult key?
	JUMPE	A,CATEG			;no.  categorize current story by dict wd
	PUSH	P,DICTWD		;save ptr to current dict word
	MOVE	DICTWD,A		;get ptr to next word in multiple key
	ADDI	WD,1			;move ptr to following word in story
	MOVE	PART1,1(TXTPTR)		;load the next story word into ACs
	MOVE	PART2,2(TXTPTR)
	MOVE	PART3,3(TXTPTR)
	MOVE	PART4,4(TXTPTR)
	HLRO	A,SORDID(WD)		;get negative length of this story word
	ASH	A,-17			;shift length into low order bits of AC
	SUB	TXTPTR,A		;move TXTPTR to the NEXT story word
	CAMGE	A,[-4]			;limit a word to 20 characters
	HRROI	A,-4
	MOVEM	A,LEN			;save pseudo length of story word
BRO:	MOVE	A,LEN			;length of story word into A
	HLRZ	FIRST,DICT(DICTWD)	;get ptr to text of dict word (mult part)
	CAME	PART1,WORDS(FIRST)	;compare story word and dict word
	JRST	NOTSAM
	AOJGE	A,EQUAL			;A=0 means we are at end of story word
	CAME	PART2,WORDS+1(FIRST)
	JRST	NOTSAM
	AOJGE	A,EQUAL
	CAME	PART3,WORDS+2(FIRST)
	JRST	NOTSAM
	AOJGE	A,EQUAL
	CAMN	PART4,WORDS+3(FIRST)
	JRST	EQUAL
NOTSAM:	HRRZ	DICTWD,DICT+2(DICTWD)	;story word not same as dict wd. get ptr to
	JUMPN	DICTWD,BRO		;  mult bro. If zero, then no bro exists.
	JRST	EQ2
;Categorize story by longest keyword that matched.  Write out new data.

CATEG:	HRRE	A,DICT+1(DICTWD)	;get pointer to first slot for current word
	JUMPL	A,EQ2			;is this a legal keyword? (PTR NOT -1?)
	SKIPGE	B,CATNBR		;YES.  ANY SIMILAR KEYWORDS CATEGORIZED?
	JRST	EQ4			;NO
	CAMN	DICTWD,KEYS(B)		;YES. Has this keyword categorized story?
	JRST	EQ2			;yes.  DONT USE THE SAME KEYWORD TWICE.
	SOJGE	B,.-2			;NO.  GET NEXT SIMILAR KEYWORD, IF ANY
EQ4:	TLO	F,CATFLG		;set "categorized" flag
	AOS	B,CATNBR		;prepare to save ptr to keyword entry in
	CAIGE	B,NKEYS			;	KEYS array to prevent duplication
	SKIPN	AVAIL,LINKS		;any slots available in LINKS file?
	JRST	EQ2		;no more room in KEYS, or no slots left in LINKS
	MOVEM	DICTWD,KEYS(B)		;save ptr to this keyword entry
	MOVE	B,LINKS(AVAIL)		;remove available slot from free slot list
	MOVEM	B,LINKS			;	and update free-slot list header
	JUMPE	A,EQ1			;IS THIS KEYWORD USED IN ANOTHER STORY?
	HRRM	AVAIL,LINKS(A)		;YES. store back ptr to new slot in old slot
	HRLM	A,LINKS(AVAIL)		;store ptr to old slot in new slot
EQ1:	MOVN	A,DICTWD		;negate dictwd pointer for storing it
	HRRM	A,LINKS(AVAIL)		;store negated dict pointer in new slot
	HRRM	AVAIL,DICT+1(DICTWD)	;store ptr to new slot in dict entry for current word
	MOVE	A,LINKS+1		;get back ptr to last slot in current story
	HRR	A,UNDUN			;GET PTR TO CURRENT STORY IN RH OF A
	MOVEM	A,LINKS+1(AVAIL)	;store those ptrs in new slot
	HRLZM	AVAIL,LINKS+1	;update back ptr to last slot for story (new slot)
EQ2:	CAMN	P,INITPD		;have all multiple word entries been popped?
	JRST	NEXTWD			;yes
	POP	P,DICTWD		;no. pop next one off stack
	SUBI	WD,1			;	and readjust ptr to word in story
	TLNE	F,CATFLG		;has the current keyword been categorized?
	JRST	EQ2			;yes. just pop rest of mult word entries.
	JRST	CATEG			;no. try to categorize it now.

DONE:	OUT	11,DCMD		;write out the new values.
	JRST	.+2
	UBIGERR	100	;	;OUT UUO FAILED TO WRITE OUT DICT
	OPEN	10,DSK17	;prepare to write out LINKS
	UERROR	110	;	;OPEN FAILED ON DSK
	SETZM	LINKSF+1
	SETZM	LINKSF+2
	SETZM	LINKSF+3
	ENTER	10,LINKSF
	UERROR	114	;	;ENTER FAILED ON FILE: LINKS
	OUT	10,LCMD		;write out LINKS file
	JRST	.+2
	UERROR	120	;	;OUT UUO FAILED TO WRITE OUT FILE: LINKS
;Write out new versions of files.

FINISH:	MOVE	B,UNDUN		;get ptr to current (UNDUN story)
	MOVEM	B,THSSTY	; AND SAVE IT FOR AUTO NOTIF
	OPEN	6,DSK17		;prepare to open INDEX for reading old version
	UERROR	124	;	;OPEN FAILED ON DSK
	SETZM	INDEXF+3
	LOOKUP	6,INDEXF	;INDEX file
	UERROR	130	;	;LOOKUP FAILED ON FILE: INDEX
	IN	6,XCMD		;read in entire INDEX file
	JRST	.+2
	UERROR	134	;	;IN UUO FAILED TO READ IN FILE: INDEX
	RELEAS	6,		;old version of INDEX that was just read
	TLNE	F,MISSIN	;should new parameters be written out for this story?
	JRST	FIN3		;no
	HLLZ	A,LINKS+1	;load back ptr to last slot for current story
	TLNE	F,TAKEFG	;is this story a take?
	HRRI	A,-1		;yes.  turn on TAKE indicator for this story
	MOVEM	A,INDEX(B)	;store back ptr and take indicator for this story
	JUMPE	PREV,FIN3	;ACs WD and PREV are the same. so if the current
	HLRZ	A,INDEX+2(PREV)	;IS PREV STORY A FOLLOW UP?
	JUMPN	A,.+2
	MOVE	A,PREV		;NO
	HRLM	A,INDEX+2(B)	;SAVE PTR TO ORIGINAL STORY
FIN1:	HRRE	A,INDEX(PREV)	;	story is to be linked up with an earlier
	JUMPLE	A,FIN2		;	one, PREV will be non-zero. if the current
	MOVE	PREV,A		;	story is not to be linked up with an
	JRST	FIN1		;	earlier story WD (PREV) will be zero
FIN2:	HRRM	A,INDEX(B)	;put whatever was in the old story's link in the new story's
	HRRM	B,INDEX(PREV)	;put a link to the new story in the old story's link
FIN3:	ADDI	B,XSIZE		;advance UNDUN
	CAIL	B,XLEN
	MOVEI	B,SPECS
	MOVEM	B,UNDUN		;put new value of UNDUN back into INDEX array
	OUT	7,XCMD		;write out new INDEX file
	JRST	.+2
	UERROR	140	;	;OUT UUO FAILED TO WRITE OUT FILE: INDEX
	RELEAS	10,		;new LINKS file
	RELEAS	11,		;new DICT file
	RELEAS	7,		;new INDEX file
	TLNE	F,MISSIN	;check if the story to have been catagorized was missing
	UBIGERR	144	;	;A STORY DISAPPEARED BEFORE BEING CATAGORIZED
	PUSH	P,PREV
	PUSHJ	P,AUTONT	;PROCESS AUTOMATIC NOTIFICATION REQUESTS
	POP	P,PREV
	SKIPE	LINKS		;have we run out of slots in LINKS?
	JRST	MORE		;no
	JUMPN	PREV,MORE	;prev ≠ 0 means LINKS wasn't read in, so we are ok
	UBIGERR	150	;	;LINKS WAS READ IN AND THERE ARE NO MORE SLOTS
;PAUSE1-4	DIGEST	DONTDO	GONE

PAUSE1:	RELEAS	0,		;LOOKUP FAILED ON NEWS
	MOVEI	A,1
	SLEEP	A,
	JRST	AGAIN1
PAUSE2:	RELEAS	7,		;ENTER FAILED ON INDEX
	MOVEI	A,1
	SLEEP	A,
	JRST	READ
PAUSE3:	RELEAS	1,		;LOOKUP FAILED ON INDEX (initial LOOKUP only)
	MOVEI	A,1		;thanx to the system, a LOOKUP can fail if someone
	SLEEP	A,		; is currently doing an ENTER of the same file
	JRST	AGAIN3
PAUSE4:	RELEAS	11,		;ENTER FAILED ON DICT
	MOVEI	A,1
	SLEEP	A,
	JRST	AGAIN4

;and now, a few kludges.

GONE:	SETOM	LINKS		;inhibit error msg about no slot in LINKS
	TLO	F,MISSIN	;set flag indicating that this story was not found
	JRST	LINKEM		;finish up

DIGEST:	OPEN	0,DSK17		;CHANNEL USED TO OUTPUT A NEW DIGEST ON 2,2
	UBIGERR	154	;	;OPEN FAILED
	MOVE	A,['  2  2']	;SET UP PPN WORD
	MOVEM	A,DIGSTF+3	; IN ENTER BLOCK
	ENTER	0,DIGSTF
	UBIGERR	160	;	;ENTER FAILED FOR DIGEST[2,2]
	OUTPUT	0,OCMD		;PUT OUT THE DIGEST
	RELEAS	0,
DONTDO:	SETZ	PREV,		;inhibit linking this story with any earlier story
	SETOM	LINKS		;inhibit error msg about no slots in LINKS
	SETZM	LINKS+1		;clear back ptr to LINKS slots for this story
	JRST	LINKEM		;finish up
;UUCODE

ECMD:	IOWD	1,BUF
	0
EMSG:	ASCIZ	/DOER  error #/]
ELEN←←.-EMSG

SAVACS:	BLOCK	20		;AREA FOR SAVING THE ACS UPON AN ERROR

UUCODE:	0
	MOVEM	17,SAVACS+17	;SAVE AN AC
	MOVEI	17,SAVACS
	BLT	17,SAVACS+16	;SAVE ALL ACS
	MOVE	P,SAVACS+P	;SET UP A PDL FOR PRINTING THE ERROR NUMBER
	HRRZ	A,40		;get error number
	MOVE	BPTR,[POINT 7,D]
	SETZ	D,
	PUSHJ	P,NXTDG
	SETO	A,
	GETLIN	A
	AOJE	A,DET
	HLRZ	A,40
	CAIN	A,(<UBIGERR>)
	OUTSTR	[ASCIZ/SUPER /]
	CAIE	A,(<UEXIT>)	;is this a horrendous error?
	OUTSTR	[ASCIZ/HORRENDOUS /]	;yes
	OUTSTR	EMSG
	OUTSTR	D
	MOVSI	17,SAVACS
	BLT	17,17		;RESTORE THE ACS
	EXIT	1,
	JRST	@UUCODE

DET:	RESET
	HLRZ	A,40
	CAIN	A,(<UEXIT>)	;is this a horrendous error?
	JRST	DETFIN		;no.  swap in new DOER
	OPEN	1,DSK17		;yes.  write message in error file
	EXIT
	SETZM	ERRORF+3
	LOOKUP	1,ERRORF
	TDZA	A,A		;lookup failed.  pretend file there with 0 words
	HLRE	A,ERRORF+3	;pick up word count of error file
	SETZM	ERRORF+3
	ENTER	1,ERRORF
	JRST	DETFIN
	DPB	A,[POINT 7,ECMD,17];put -(word count mod 200) into dump mode command
	MOVN	A,A		;make word count positive
	LDB	B,[POINT 11,A,28];get record part of count
	ANDI	A,177		;get remainder
	JUMPE	A,PUTERR	;if no remainder, then dont read in anything
	USETI	1,1(B)
	IN	1,ECMD
	JRST	.+2
	EXIT
PUTERR:	MOVEI	C,BUF(A)
	HRLI	C,EMSG
	BLT	C,BUF+ELEN-1(A)	;put error message into block to be output
	MOVEM	D,BUF+ELEN(A)	;put ASCIZ error number into block
	MOVE	C,[ASCIZ/
/]
	MOVEM	C,BUF+ELEN+1(A)	;put crlf after error number
	MOVNI	A,ELEN+2(A)	;calculate number of words to be written out
	HRLM	A,ECMD		; and put it negated into dump mode command
	USETO	1,1(B)
	OUTPUT	1,ECMD
	RELEAS	1,
DETFIN:	SKIPE	RESTAR		;is this a restarted DOER?
	EXIT			;yes.  dont restart again
	HLRZ	A,40		;no
	MOVEI	B,SWAPBK
	CAIE	A,(<UBIGERR>)	;super horrendous error?
	SWAP	B,		;no.  swap in and start up fresh version of DOER
	EXIT

NXTDG:	IDIVI	A,=8		;convert number in AC A to octal ASCII string
	PUSH	P,B
	SKIPE	A
	PUSHJ	P,NXTDG
	POP	P,A
	ADDI	A,60
	IDPB	A,BPTR
	POPJ	P,
;INTRPT	CHGNAM

INTRPT:	MOVE	A,JOBCNI
	JFFO	A,.+1
	CAIN	A+1,=19			;was it an interrupt to set the job name
	JRST	CHGNAM			;yes.  do it.
	MOVEM	A+1,SVINTR#		;save indicator of the cause of interrupt
	UWAIT
	JRST@	2,[.+1]			;no.  get out of user-iot.
	DEBREAK
	MOVE	A,SVINTR
	CAIE	A,=9			;was the interrupt for a parity error?
	UBIGERR	174	;	;UNKNOWN INTERRUPT OCCURRED
	UEXIT	200	;	;PARITY ERROR

CHGNAM:	SETZ	A,			;zero out job name
	SETNAM	A,
	SETOM	NRDOER			;initialize indicator to one other doer
	MOVE	A,NAME
	NAMEIN	A,
	JRST	.+2			;zero or multiple doers exist
	DISMIS				;exactly one other doer exists
	SETZM	NRDOER			;set indicator to multiple doers
	CAIE	A,1			;check error code of NAMEIN
	DISMIS				;multiple doers exist
	AOS	NRDOER			;set indicator to no other doers
	MOVE	A,NAME			;set job name
	SETNAM	A,
	MOVEI	A,200000
	INTACM	A,			;disable further pdl ov interrupts
	DISMIS
;GETUFD	GUFD	DELALL	INDEL	AUTONT

IUFD:	BLOCK	3		;BUFFER HEADER FOR UFD
ITAD:	BLOCK	3		;BUFFER HEADER FOR .ADD AND .TAD AND OLD NOTIF FILES
ONTF:	BLOCK	3		;BUFFER HEADER FOR NEW NOTIF
ONAP:	BLOCK	3		;BUFFER HEADER FOR .NAP FILES

UFD210:	210
	SIXBIT	/DSK/
	IUFD
INT210:	210
	SIXBIT	/DSK/
	ITAD
ONT210:	210
	SIXBIT	/DSK/
	ONTF,,
NAP210:	210
	SIXBIT	/DSK/
	ONAP,,
FLAGFL←'###'			;NAME OF FLAG FILE
FCMD:	IOWD	1,ITAD		;DUMP MODE COMMAND FOR WRITING ONE WORD IN FLAG FILE
	0
UFDBUF:	BLOCK	203		;BUFFER FOR READING UFD
FILLEN:	0			;SAVED NEGATIVE SWAPPED WORD COUNT OF A .DEL FILE
DELLEN:	0			;LENGTH OF RQ DELETION LIST
DELBEG:	0			;ADDRESS OF START OF RQ DELETION LIST
TODAY:	0			;TODAY'S DATE (IN SYSTEM DATE FORMAT)

GETUFD:	SETZ	PT1,
	DSKPPN	PT1,		;GET DISK PPN, WHICH IS NAME OF UFD WE WANT TO OPEN
	MOVSI	PT2,'UFD'
	MOVE	PT4,['  1  1']
	LOOKUP	UFD,PT1
	UBIGERR	204	;	;CAN'T FIND AP,SYS UFD
	POPJ	P,

;ROUTINE TO SET UP LOOKUP BLOCK FOR NEXT AUTO NOTIF FILE.
GUFD:	SOSG	IUFD+2
	JRST	GUFD2
GUFD1:	ILDB	PT1,IUFD+1	;GET FILE NAME
	ILDB	PT2,IUFD+1	; AND EXTENSION
	MOVEI	PT3,2
	ADDM	PT3,IUFD+1	;SKIP OVER LAST TWO WORDS OF FILE INFO IN UFD
	JUMPE	PT1,GUFD	;ZERO FILE NAME MEANS NO FILE HERE
	TLNE	PT1,-1		;LEFT HALF OF FILE NAME MUST BE ZERO
	JRST	GUFD		;NOPE.  THIS ISN'T ONE OF OUR AUTO NOTIF FILES.
	HLLZ	PT2,PT2		;CLEAR RIGHT HALF OF EXTENSION WORD
	SETZ	PT4,		;SET UP PPN WORD
	POPJ	P,
GUFD2:	IN	UFD,
	JRST	GUFD3
	STATO	UFD,20000	;EOF?
	UBIGERR	210	;	;NO.  INPUT ERROR IN READING UFD
	SUB	P,[2,,2]	;RETURN UP TWO LEVELS
	JRST	@1(P)
GUFD3:	MOVE	PT1,IUFD+2	;GET BYTE COUNT
	ASH	PT1,-2		; AND DIVIDE BY 4
	MOVEM	PT1,IUFD+2	;AND RE-STORE IT
	JRST	GUFD1		;GO GET NEXT FILE NAME FROM UFD

;ROUTINE TO DELETE ALL .TDL AND .TAD FILES
DELALL:	PUSHJ	P,GETUFD	;OPEN UFD
DELAL1:	PUSHJ	P,GUFD		;GET NEXT FILE NAME FROM UFD
	CAME	PT2,['TDL   ']	;IS IT ONE OF THESE TEMPORARY FILES?
	CAMN	PT2,['TAD   ']
	LOOKUP	TDL,PT1		;YES.  OPEN WIDE
	JRST	DELAL1
	SETZB	PT1,PT4		;NOW GO AWAY
	RENAME	TDL,PT1		;DELETE THIS .TAD OR .TDL FILE
	JRST	DELAL1		;HOW CAN THIS LITTLE OLE RENAME FAIL, ANYWAY?
	JRST	DELAL1

;ROUTINE TO READ A .TDL OR A .DEL FILE INTO DELETION AREA.
;UPDATES THE LENGTH OF THE DELETION AREA, EXPANDING CORE IF NECESSARY.
INDEL0:	SKIPN	PT4,FILLEN	;GET LENGTH OF .DEL OR .TDL FILE
INDEL:	JUMPE	PT4,CPOPJ	;FORGET ABOUT EMPTY FILES
	HRR	PT4,JOBFF	;SET UP DUMP MODE COMMAND
	SUBI	PT4,1		;RH = LOC-1
	SETZ	PT5,		;ZERO WORD FOLLOWING COMMAND
	HLRE	A,PT4		;PICK UP WORD COUNT
	MOVN	A,A		; AND MAKE IT POSITIVE
	ADDM	A,DELLEN	;LIST OF DELETIONS GETS THIS MUCH LONGER
	ADDB	A,JOBFF		;ADJUST JOBFF AND PREPARE TO EXPAND CORE
	CAMG	A,JOBREL	;DO WE NEED TO EXPAND?
	JRST	INDEL1		;NOPE
	CORE	A,		;YUP
	UBIGERR	214	;	;CORE UUO FAILED
INDEL1:	IN	TDL,PT4		;READ IN THIS DELETE FILE
	POPJ	P,
	UBIGERR	220	;	;IN UUO FAILED TO READ IN .DEL OR .TDL FILE

;MAIN ROUTINE FOR PROCESSING AUTOMATIC NOTIFICATION REQUESTS
AUTONT:
	SETZ	A,
	RUNTIM	A,		;GET CPU TIME UP TO NOW
	MOVN	A,A		; AND SUBTRACT IT FROM TIME USED SO FAR IN NOTIF
	ADDM	A,ANTIM
	DATE	A,		;GET TODAY'S DATE
	MOVEM	A,TODAY		; AND SAVE IT
	OPEN	UFD,UFD210	;CHANNEL FOR UFD OF AP,SYS
	UBIGERR	224	;	;OPEN FAILED ON DSK
	MOVEI	A,UFDBUF	;GET ADDRESS FOR BUFFER FOR UFD INPUT
	EXCH	A,JOBFF		; AND SET UP JOBFF FOR THE INBUF
	INBUF	UFD,1		;SET UP ONE BUFFER FOR UFD
	MOVEM	A,JOBFF		;RESTORE JOBFF
	OPEN	TDL,DSK17	;CHANNEL FOR DELETING FILES & FOR .DEL & .TDL FILES
	UBIGERR	230	;	;OPEN FAILED ON DSK
	OPEN	DUN,DSK17	;CHANNEL FOR SPECIAL FLAG FILE
	UBIGERR	234	;	;OPEN FAILED ON DSK
	MOVEI	PT1,FLAGFL	;SET UP LOOKUP BLOCK FOR FLAG FILE
	SETZB	PT2,PT4
	LOOKUP	DUN,PT1		;IS FLAG FILE THERE?
	JRST	AN1		;MAYBE NOT
	PUSHJ	P,DELALL	;YES!  DELETE ALL .TDL AND .TAD FILES
	SETZB	PT1,PT4
	RENAME	DUN,PT1		;NOW DELETE THE FLAG FILE
	UBIGERR	240	;	;RENAME FAILED TO DELETE FLAG FILE
	JRST	AN2
AN1:	TRNE	PT2,-1		;CHECK LOOKUP CODE.  FLAG FILE NON-EXISTENT?
	UBIGERR	244	;	;NO! LOOKUP FAILED ON NOT NON-EXISTENT FLAG FILE
AN2:	PUSHJ	P,GETUFD	;OPEN UFD OF AP,SYS TO LOOK FOR .TDL FILES
	PUSH	P,[AN4]		;SET UP RETURN ADDRESS FOR EOF ON UFD
	SETZM	DELLEN		;CLEAR LENGTH OF DELETE AREA
	MOVE	PT1,JOBFF	; AND GET PTR TO BEGINNING OF SAME
	MOVEM	PT1,DELBEG	; AND SAVE IT
AN3:	PUSHJ	P,GUFD		;GET NEXT FILE NAME FROM UFD
	CAMN	PT2,['TDL   ']	;IS THIS A .TDL FILE?
	LOOKUP	TDL,PT1		;YES.  IS IT THERE?
	JRST	AN3		;NO TO ONE OF THESE
	PUSHJ	P,INDEL		;YES TO BOTH.  READ IN .TDL FILE
	JRST	AN3		; AND GO GET NEXT ONE

AN4:	PUSHJ	P,GETUFD	;OPEN UFD OF AP,SYS TO LOOK FOR .DEL FILES
	PUSH	P,[AN6]		;SET UP RETURN ADDRESS FOR EOF ON UFD
AN5:	PUSHJ	P,GUFD		;GET NEXT FILE NAME FROM UFD
	CAMN	PT2,['DEL   ']	;IS THIS A .DEL FILE?
	LOOKUP	TDL,PT1		;YES.  IS IT THERE?
	JRST	AN5		;NO TO ONE OF THESE
	MOVEM	PT4,FILLEN	;YES.  SAVE LENGTH OF .DEL FILE
	MOVSI	PT2,'TDL'	;RENAME .DEL FILE TO .TDL
	SETZ	PT4,
	RENAME	TDL,PT1		;IS THIS FILE BUSY, OR IS THERE ALREADY A .TDL FILE?
	JRST	AN5		;YES TO ONE OF THOSE
	PUSHJ	P,INDEL0	;NO.  EVERYTHING OK.  READ IN NEW .TDL FILE
	JRST	AN5		; AND GO GET NEXT .DEL FILE

AN6:	OPEN	TAD,INT210	;CHANNEL FOR OLD NOTIF FILE AND .ADD AND .TAD FILES
	UBIGERR	250	;	;OPEN FAILED ON DSK
	OPEN	NT,ONT210	;CHANNEL FOR NEW NOTIF FILE
	UBIGERR	254	;	;OPEN FAILED ON DSK
	SETZM	SERIAL		;NO SERIAL NUMBERS USED YET
	MOVE	PT1,['NOTIF ']	;SET UP LOOKUP/ENTER BLOCK FOR NOTIF
	SETZB	PT2,PT3
	SETZ	PT4,
	ENTER	NT,PT1		;CREATE NEW NOTIF FILE
	UBIGERR	260	;	;ENTER FAILED ON NOTIF
	SETZ	PT4,
	LOOKUP	TAD,PT1		;GRAB OLD NOTIF FILE
	JRST	AN7		;LOOKUP FAILED ON NOTIF.  SEE IF FILE NON-EXISTENT
	PUSHJ	P,PROCRQ	;PROCESS REQUESTS FROM OLD NOTIF
	JRST	AN8
AN7:	TRNE	PT2,-1		;CHECK LOOKUP CODE.  IS NOTIF NON-EXISTENT?
	UBIGERR	264	;	;NO.  LOOKUP FAILED ON NOT NON-EXISTENT NOTIF FILE
AN8:	PUSHJ	P,GETUFD	;OPEN UFD OF AP,SYS TO LOOK FOR .TAD FILES
	PUSH	P,[AN10]	;SET UP RETURN ADDRESS FOR EOF IN UFD
AN9:	PUSHJ	P,GUFD		;GET NEXT FILE NAME FROM UFD
	CAMN	PT2,['TAD   ']	;IS THIS A .TAD FILE?
	LOOKUP	TAD,PT1		;YES.  IS IT THERE?
	JRST	AN9		;NO TO ONE OF THESE
	PUSHJ	P,PROCRQ	;PROCESS REQUESTS FROM THIS .TAD FILE
	JRST	AN9
AN10:	PUSHJ	P,GETUFD	;OPEN UFD OF AP,SYS TO LOOK FOR .ADD FILES
	PUSH	P,[AN12]	;SET UP RETURN ADDRESS FOR EOF IN UFD
AN11:	PUSHJ	P,GUFD		;GET NEXT FILE NAME FROM UFD
	CAMN	PT2,['ADD   ']	;IS THIS A .ADD FILE?
	LOOKUP	TAD,PT1		;YES.  IS IT THERE?
	JRST	AN11		;NO TO ONE OF THESE
	MOVSI	PT2,'TAD'	;RENAME THIS FILE TO .TAD
	SETZ	PT4,
	RENAME	TAD,PT1		;IS THIS FILE BUSY, OR IS THERE ALREADY A .TAD FILE?
	JRST	AN11		;YES TO ONE OF THOSE
	PUSHJ	P,PROCRQ	;NO TO BOTH.  PROCESS REQUESTS FROM THIS FILE
	JRST	AN11

AN12:	MOVEI	PT1,FLAGFL	;SET UP ENTER BLOCK FOR SPECIAL FLAG FILE
	SETZB	PT2,PT3
	SETZ	PT4,
	ENTER	DUN,PT1		;SET SPECIAL FLAG BY CREATING NEW FLAG FILE
	UBIGERR	270	;	;ENTER FAILED ON SPECIAL FLAG FILE
;	OUT	DUN,FCMD	;MAKE FLAG FILE NON-EMPTY
;	JRST	.+2
;	UBIGERR	274	;	;OUT UUO FAILED TO WRITE OUT SPECIAL FLAG FILE
	MOVEI	A,'EOF'		;PUT EOF MARKER ON END OF NOTIF FILE
	PUSHJ	P,PNTF
	RELEAS	NT,		;CLOSE NEW NOTIF FILE
	CLOSE	DUN,		;SET FLAG BY CLOSING FLAG FILE
	PUSHJ	P,DELALL	;DELETE ALL .TAD AND .TDL FILES
	SETZB	PT1,PT4
	RENAME	DUN,PT1		;CLEAR FLAG BY DELETING SPECIAL FLAG FILE
	UBIGERR	300	;	;RENAME FAILED TO DELETE FLAG FILE

	RELEAS	DUN,		;RELEAS ALL CHANNELS USED FOR AUTOMATIC NOTIF
	RELEAS	TAD,
	RELEAS	TDL,
	RELEAS	UFD,

	HLRZ	A,JOBSA		;GET ORIGINAL SIZE OF JOB
	MOVEM	A,JOBFF		; AND RESTORE IT (BUT DONT SHRINK CORE)

	SETZ	A,
	RUNTIM	A,		;GET CPU TIME
	ADDM	A,ANTIM		; AND ADD TO TIME USED FOR AUTO NOTIF

	POPJ	P,		;AT LAST WE ARE DONE
;PROCRQ

SMINUS:	-1,,2			;SYMBOL REPRESENTING SET DIFFERENCE OPERATOR
SPLUS:	-1,,1			;SYMBOL REPRESENTING UNION OPERATOR
SSTAR:	-1,,0			;SYMBOL REPRESENTING INTERSECTION OPERATOR

PRJPRG:	C,,400000		;INDIRECT PTR INTO SYSTEM PRJPRG TABLE
JBTLIN:	C,,400000		;INDIRECT PTR INTO SYSTEM JBTLIN TABLE

SERIAL:	0			;2ND WORD OF CURRENT RQ (CURRENT SERIAL NUMBER)
LENWRD:	0			;3RD WORD OF CURRENT RQ (P,,L ;LENGTHS)
DATEPN:	0			;4TH WORD OF CURRENT RQ (DATE,,PN)
CURPDL:	0			;VALUE OF P SAVED WHEN PROCRQ IS CALLED

GNTF:	SOSG	ITAD+2		;GET NEXT WORD FROM INPUT NOTIFICATION FILE
	IN	TAD,
	JRST	GNTF1
	UBIGERR	304	;	;IN ERROR FROM NOTIFICATION FILE BEFORE EOF MARKER
GNTF1:	ILDB	A,ITAD+1
CPOPJ:	POPJ	P,

PNTF:	SOSG	ONTF+2		;PUT OUT A WORD INTO NEW NOTIFICATION FILE
	OUTPUT	NT,
	IDPB	A,ONTF+1
	POPJ	P,

PNAP:	SOSG	ONAP+2		;PUT OUT A WORD INTO .NAP FILE
	OUTPUT	NAP,
	IDPB	A,ONAP+1
	POPJ	P,

PROCRQ:	MOVEM	P,CURPDL	;SAVE PDL POINTER TO MAKE SURE EXPR IS OK
PR0:	PUSHJ	P,GNTF		;GET FIRST WORD OF RQ
	CAIN	A,'EOF'		;IS THIS AN EOF MARKER?
	POPJ	P,		;YES.  DONE WITH THIS FILE.
	CAME	A,[-1]		;NO.  SHOULD BE -1
	UBIGERR	310	;	;FIRST WORD OF RQ WAS NOT -1 (OR EOF)
	PUSHJ	P,GNTF		;GET SECOND WORD OF RQ: SERIAL NUMBER
	CAMN	A,[-1]		;IS THIS A NEW RQ? (IE, NO SERIAL NUMBER?)
	AOSA	A,SERIAL	;YES.  ASSIGN IT A SERIAL NUMBER
	MOVEM	A,SERIAL	;SAVE THE SERIAL NUMBER
	PUSHJ	P,GNTF		;GET THIRD WORD OF RQ: P,,L (LENGTH WORD)
	MOVEM	A,LENWRD	; AND SAVE IT
;	HLRZM	A,POLLEN	;SAVE LENGTH OF POLISH EXPRESSION
	HRRZ	B,A		; AND LENGTH OF REMAINDER OF RQ
	PUSHJ	P,GNTF		;GET FOURTH WORD OF RQ: DATE,,PN
	MOVEM	A,DATEPN	;SAVE THIS WORD OF RQ
	LDB	C,[POINT 12,A,17];PICK UP EXPIRATION DATE
	CAMG	C,TODAY		;RQ EXPIRED?
	JRST	RQEXP		;YES

PR8:	MOVE	A,SERIAL	;RETRIEVE SERIAL NUMBER
	MOVN	C,DELLEN	;GET LENGTH OF RQ DELETION AREA
	JUMPGE	C,PR7		;ANY DELETIONS?
	MOVSI	C,(C)		;YES.  SET UP AOBJN PTR
	HRR	C,DELBEG
	CAMN	A,(C)		;CURRENT RQ BEING DELETED?
	JRST	SKIPRQ		;YUP
	AOBJN	C,.-2		;NO. SEE IF ANY MORE DELETIONS
PR7:	SETO	A,		;RQ NOT BEING DELETED.  COPY TO NEW NOTIF
	PUSHJ	P,PNTF
	MOVE	A,SERIAL
	PUSHJ	P,PNTF
	MOVE	A,LENWRD
	PUSHJ	P,PNTF
	MOVE	A,DATEPN
	PUSHJ	P,PNTF
NXTERM:	PUSHJ	P,GNTF		;GET NEXT TERM OF POLISH EXPRESSION
	PUSHJ	P,PNTF		;COPY WORD TO NEW NOTIF
	TLNE	A,-1		;IS THIS A DICT PTR?
	JRST	NXTER1		;NO
	JUMPE	A,PR9		;IS IT THE END OF POLISH EXPR?
	CAIL	A,DLEN		;NO
	UBIGERR	314	;	;DICT PTR IN RQ OUT OF RANGE
	HRRE	A,DICT+1(A)	;GET PTR FROM DICT INTO LINKS
	JUMPLE	A,PUSH0		;IF -1 OR 0, NO STORIES FOR THIS KEYWORD
	CAIL	A,LLEN
	UBIGERR	320	;	;PTR INTO LINKS IS OUT OF RANGE
	HRRE	A,LINKS+1(A)	;GET PTR FROM LINKS TO INDEX
	SETO	B,		;ASSUME STORY MATCHES
	CAME	A,THSSTY	;KEYWORD IN CURRENT STORY?
PUSH0:	SETZ	B,		;NO
	PUSH	P,B		;SAVE VALUE OF THIS TERM
	JRST	NXTERM		; AND GO GET NEXT TERM

NXTER1:	JUMPGE	A,SEARCH	;IS THIS A SEARCH LENGTH INDICATOR?
	POP	P,B		;NO.  MUST BE OPERATOR.  POP LAST ARGUMENT
	CAMN	A,SSTAR		;IS IT THE INTERSECTION OPERATOR?
	JRST	TIMES		;YES
	CAMN	A,SPLUS		;IS IT THE UNION OPERATOR?
	JRST	PLUS		;YES
	CAME	A,SMINUS	;IS IT THE SET DIFFERENCE OPERATOR?
	UBIGERR	324	;	;NO.  ILLEGAL TERM IN POLISH EXPRESSION IN RQ
MINUS:	JUMPE	B,NXTERM	;IF SECOND OPERAND IS ZERO, NOTHING SPECIAL TO DO
	SETZM	(P)		;SECOND OPERAND NON-ZERO.  RESULT OF OPERATION IS 0
	JRST	NXTERM
PLUS:	JUMPE	B,NXTERM	;IF SECOND OPERAND IS ZERO, NOTHING SPECIAL TO DO
	SETOM	(P)		;SECOND OPERAND NON-ZERO.  RESULT OF OPERATION IS -1
	JRST	NXTERM
TIMES:	ANDM	B,(P)		;PERFORM INTERSECTION OPERATION
	JRST	NXTERM

SEARCH:	HLRZ	B,A		;GET LENGTH OF SEARCH STRING
	CAIE	B,(A)		;MAKE SURE WE HAVE LEGAL SEARCH SPECIFICATION
	UBIGERR	330	;	;ILLEGAL SEARCH LENGTH INDICATOR
	PUSHJ	P,GNTF		;GET NEXT WORD FROM RQ
	PUSHJ	P,PNTF		; AND SAVE IT IN NEW NOTIF
	SOJG	B,.-2		;GOT WHOLE SEARCH INDICATOR?
	JRST	PUSH0		;YES.  ASSUME SEARCH STRING NOT FOUND (FOR NOW)

OPENAP:	OPEN	NAP,NAP210	;CHANNEL FOR .NAP[2,2] FILE
	UBIGERR	334	;	;OPEN FAILED ON DSK
	HRRZ	PT1,DATEPN	;PUT PROGRAMMER NAME INTO LOOKUP/ENTER BLOCK
	MOVSI	PT2,'NAP'	;THE OLE .NAP[2,2] FILE
	MOVE	PT4,['  2  2']	;THIS IS WHERE THE MSG FILES LIVE
	LOOKUP	NAP,PT1		;SEE IF ANY OLD .NAP FILE THERE
	JRST	OPENA1
	MOVE	PT4,['  2  2']	;SET UP PPN FOR ENTER
OPENA2:	ENTER	NAP,PT1		;MAKE NEW .NAP FILE OR OPEN OLD ONE IN RA MODE
	JRST	OPENA3		;ENTER FAILED ON .NAP FILE
	UGETF	NAP,A		;EXTEND OLD FILE, IF ANY
	AOS	(P)		;TAKE SKIP RETURN ON SUCCESS
	POPJ	P,
OPENA1:	TRNE	PT2,-1		;CHECK ERROR CODE FROM LOOKUP
	POPJ	P,		;FILE EXISTS BUT MUST BE BUSY OR SOMETHING
	SETZ	PT3,		;FILE DOESN'T EXIST.  CLEAR PROTECTION FOR ENTER.
	JRST	OPENA2
OPENA3:	RELEAS	NAP,		;ENTER FAILED.  ASSUME FILE BUSY.
	POPJ	P,		; AND TAKE ERROR (DIRECT) RETURN

SKIPRQ:	PUSHJ	P,GNTF		;THIS RQ IS GOING AWAY.  SKIP TO THE END OF IT.
	SOJG	B,.-1
	JRST	PR0

RQEXP:	PUSHJ	P,OPENAP	;OPEN MESSAGE FILE
	JRST	PR8		;CANT OPEN IT.  LET THIS RQ LIVE A WHILE LONGER
	MOVEI	B,EXPMSG	;PUT EXPIRATION LEADER INTO FILE
	PUSHJ	P,NAPSTR
	PUSHJ	P,GNTF		;SKIP OVER POLISH
	JUMPN	A,.-1		;END OF POLISH?
	JRST	.+2		;YES
RQEXP1:	PUSHJ	P,PNAP		;SAVE WORD IN MESSAGE FILE
	PUSHJ	P,GNTF		;GET NEXT WORD OF ASCII
	TLNE	A,-1		;END OF ASCII?
	JRST	RQEXP1		;NO
	MOVEI	B,XSTMSG	;YES.  PUT EXPIRATION FOLLOWER INTO FILE
	PUSHJ	P,NAPSTR
	PUSHJ	P,FINNAP	;PUT STORY NUMBER/TIME INTO .NAP FILE AND CLOSE IT
	PUSHJ	P,GNTF		;GET LAST WORD OF RQ
	JUMPE	A,PR0		; WHICH SHOULD BE ZERO
	UBIGERR	340	;	; BUT ISN'T!!!

NAPSTR:	MOVE	A,(B)		;GET NEXT WORD OF TEXT
	JUMPE	A,CPOPJ		;IF IT'S ZERO, THEN THAT'S ALL
	PUSHJ	P,PNAP		;OTHERWISE, PUT IT INTO MESSAGE FILE
	AOJA	B,NAPSTR	;GO ON TO NEXT WORD

FNDMSG:	ASCII	\∂
FOUND \				;FOUND-STORY LEADER
	0
EXPMSG:	ASCII	\∂
YOUR REQUEST \			;EXPIRED-STORY LEADER
	0
STYMSG:	ASCII	\
IN STORY #\			;FOUND-STORY FOLLOWER
	0
XSTMSG:	ASCII	\
EXPIRED BEFORE STORY #\		;EXPIRED-STORY FOLLOWER
	0			;EACH MESSAGE MUST END WITH A ZERO WORD


PR9:	POP	P,A		;GET RESULT OF WHOLE EXPRESSION
	CAME	P,CURPDL	;IS PDL OK?
	UBIGERR	344	;	;NO.  PDL SCREWED UP!!
	AOJN	A,PR3		;STORY DOESN'T MATCH RQ
	PUSHJ	P,OPENAP	;OPEN .NAP FILE
	JRST	PR3		;CANT OPEN IT
	MOVEI	B,FNDMSG	;PUT STORY-FOUND LEADER ON MESSAGE
	PUSHJ	P,NAPSTR
	JRST	.+2
PR2:	PUSHJ	P,PNAP		;PUT NEXT WORD OF MESSAGE INTO .NAP
	PUSHJ	P,GNTF		;GET NEXT WORD OF ASCII FROM RQ
	PUSHJ	P,PNTF		; AND COPY IT INTO NEW NOTIF
	TLNE	A,-1		;END OF ASCII?
	JRST	PR2		;NO
	PUSHJ	P,GNTF		;GET LAST WORD OF RQ
	JUMPE	A,.+2		;IS IT ZERO, AS IT SHOULD BE?
	UBIGERR	350	;	;NO.  LAST WORD OF RQ IS NON-ZERO
	PUSHJ	P,PNTF		;SAVE LAST WORD IN NOTIF
	MOVEI	B,STYMSG	;PUT STORY-FOUND FOLLOWER INTO MESSAGE FILE
	PUSHJ	P,NAPSTR
	PUSHJ	P,FINNAP	;PUT STORY NUMBER/TIME INTO .NAP FILE AND CLOSE IT

	MOVSI	A,-1
	SETPR2	A,		;LOOK INTO MONITOR TO SEE IF THIS GUY IS LOGGED IN
	JRST	PR0		;WELL, IF SETPR2 FAILS, DONT TTYMES ANYONE
	MOVE	B,400211	;GET PTR TO PRJPRG TABLE
	DPB	B,[POINT 17,PRJPRG,35]; AND SAVE IT
	MOVE	B,400236	;GET PTR TO JBTLIN TABLE
	DPB	B,[POINT 17,JBTLIN,35]; AND SAVE IT
	MOVE	C,400222	;GET MAXIMUM JOB NUMBER
	HRRZ	A,DATEPN	;GET OUR REQUESTOR'S PROGRAMMER NAME
PR4:	HRRZ	B,@PRJPRG	;GET PROGRAMMER NAME OF A JOB
	CAIN	A,(B)		;DOES THAT JOB BELONG TO OUR FRIEND?
	JRST	PR5		;YES.  TTYMES HIM
PR6:	SOJG	C,PR4		;ON TO NEXT JOB, IF ANY
	JRST	PR0		;NO MORE JOBS.  NOW MOSEY ON TO NEXT RQ

PR5:	MOVE	B,@JBTLIN	;SEE WHAT TTY THIS JOB IS ON
	CAMN	B,[-1]		;IS HE DETACHED?
	JRST	PR6		;YES.  FORGET HIM
	HRRZM	B,TTMESS	;NO.  SAVE TTY NUMBER IN TTYMES BLOCK
	MOVEI	B,TTMESS	;SET UP ADDRESS FOR TTYMES
	TTYMES	B,		;SEND THE STANDARD MESSAGE TO THIS GUY
	JFCL			;IF IT FAILS, SO WHAT?
	JRST	PR6

TTMESS:	0			;TTY NUMBER GOES HERE
	.+1			;POINTER TO ASCIZ MESSAGE
	ASCIZ	\
*** AP STORY FOUND ***
\]

PR3:	PUSHJ	P,GNTF		;GET NEXT WORD OF ASCII FROM RQ
	PUSHJ	P,PNTF		; AND COPY IT INTO NEW NOTIF
	TLNE	A,-1		;END OF ASCII?
	JRST	PR3		;NO
	PUSHJ	P,GNTF		;GET LAST WORD OF RQ
	JUMPE	A,.+2		;IS IT ZERO, AS IT SHOULD BE?
	UBIGERR	354	;	;NO.  LAST WORD OF RQ IS NON-ZERO
	PUSHJ	P,PNTF		;SAVE LAST WORD IN NOTIF
	JRST	PR0		;GET THE NEXT RQ

FINNAP:	MOVE	B,BEGSTY	;GET BYTE POINTER TO BEGINNING OF STORY
	ILDB	A,B
	PUSHJ	P,PNAP		;PUT STORY NUMBER AND TIME INTO .NAP FILE
	ILDB	A,B
	PUSHJ	P,PNAP
	ILDB	A,B
	PUSHJ	P,PNAP
	ILDB	A,B
	PUSHJ	P,PNAP
	RELEAS	NAP,		;THAT DOES IT FOR THE .NAP FILE
	POPJ	P,
;XIT	

XIT:	SETZ	A,
	RUNTIM	A,
	ADDM	A,DOTIM		;CALCULATE TOTAL TIME USED BY THIS RUN OF DOER
	OPEN	2,DSK17		;CHANNEL USED FOR STATISTICS FILE
	UBIGERR	360	;	;OPEN FAILED ON DSK
	SETZM	DOTIMF+3
	LOOKUP	2,DOTIMF	;FIND OLD STATISTICS FILE
	JRST	XIT2		;FAILED
	IN	2,DTCMD		;READ IN OLD FILE
	JRST	.+2
	UBIGERR	364	;	;IN UUO FAILED TO READ IN STATISTICS FILE
	CLOSE	2,
XIT1:	MOVSI	B,-DATLEN	;SET UP AOBJN PTR FOR ADDING IN CURRENT STATISTICS
	MOVE	A,DODAT(B)	;GET LOCAL DATA
	ADDM	A,TOTDAT+1(B)	; AND ADD IN TO GLOBAL DATA
	AOBJN	B,.-2		;GET NEXT PIECE OF DATA
	SETZM	DOTIMF+2	;CLEAR PROTECTION
	SETZM	DOTIMF+3	; AND PPN
	ENTER	2,DOTIMF	;NEW STATISTICS FILE
	UBIGERR	370	;	;FAILED
	OUT	2,DTCMD		;WRITE OUT NEW DATA
	EXIT			;FINISHED.  CLOSE NEW STATISTICS FILE AND LEAVE
	UBIGERR	374	;	;FAILED

XIT2:	HRRZ	A,DOTIMF+1	;GET ERROR CODE
	JUMPE	A,.+2		;BETTER BE ZERO (NO FILE)
	UBIGERR	400	;	;NON-ZERO ERROR CODE
	ACCTIM	A,		;PUT CURRENT TIME AND DATE INTO NEW FILE
	MOVEM	A,TOTDAT
	SETZM	TOTDAT+1	;CLEAR GLOBAL DATA
	MOVE	A,[TOTDAT+1,,TOTDAT+2]
	BLT	A,TOTDAT+DATLEN+1
	JRST	XIT1

	END	DOER